home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 07 / 6 / DISK0760.ZIP / MOUSTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-14  |  8KB  |  334 lines
  1. Program Mouse_Test(Input,Output);
  2.  
  3. Uses
  4.   Dos,
  5.   Crt,
  6.   Graph,
  7.   MgMouse;
  8.  
  9. Const
  10.   NewCursor : MG_MouseCursor =
  11.                (($FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,$0000,$0000,
  12.                  $FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,$0000,$0000),
  13.                 ($0000,$0000,$FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,
  14.                  $0000,$0000,$FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF));
  15.  
  16. Var
  17.   Ch,Choice : Char;
  18.   ChooseDefaultCursor : Boolean;
  19.  
  20. Procedure PollTheMouse;
  21. Begin
  22. Writeln;
  23. Writeln('PollTheMouse');
  24. Repeat
  25.   MousePoll;
  26.   ClrEol;
  27.   If LeftButtonPressed then
  28.     Writeln('LeftButtonPressed      ',M1,'  ',M2,'  ',M3,'  ',M4);
  29.   If RightButtonPressed then
  30.     Writeln('RightButtonPressed     ',M1,'  ',M2,'  ',M3,'  ',M4);
  31.   If MiddleButtonPressed then
  32.     Writeln('MiddleButtonPressed    ',M1,'  ',M2,'  ',M3,'  ',M4);
  33. Until KeyPressed;
  34. While KeyPressed do
  35.   Ch := ReadKey;
  36. End; {PollTheMouse}
  37.  
  38. Procedure ReadLeftButton;
  39. Begin
  40. Writeln;
  41. Writeln('MouseLeftButtonInfo');
  42. Repeat                                 {** Get info. on left button **}
  43.   MouseButtonPressed(Left);
  44.   ClrEol;
  45.   If LeftButtonPressed then
  46.     Writeln('LeftButton  ',M1,'  ',M2,'  ',M3,'  ',M4);
  47. Until KeyPressed;
  48. While KeyPressed do
  49.   Ch := ReadKey;
  50. End; {LeftButton}
  51.  
  52. Procedure ReadRightButton;
  53. Begin
  54. Writeln;
  55. Writeln('MouseRightButtonInfo');
  56. Repeat                                 {** Get info. on right button **}
  57.   MouseButtonPressed(Right);
  58.   ClrEol;
  59.   If RightButtonPressed then
  60.     Writeln('RightButton  ',M1,'  ',M2,'  ',M3,'  ',M4);
  61. Until KeyPressed;
  62. While KeyPressed do
  63.   Ch := ReadKey;
  64. End; {ReadRightButton}
  65.  
  66. Procedure ReadMiddleButton;
  67. Begin
  68. Writeln;
  69. Writeln('MouseMiddleButtonInfo');
  70. Repeat                                 {** Get info. on right button **}
  71.   MouseButtonPressed(Middle);
  72.   ClrEol;
  73.   If MiddleButtonPressed then
  74.     Writeln('MiddleButton  ',M1,'  ',M2,'  ',M3,'  ',M4);
  75. Until KeyPressed;
  76. While KeyPressed do
  77.   Ch := ReadKey;
  78. End; {ReadMiddleButton}
  79.  
  80. Procedure Move_The_Mouse;
  81. Begin
  82. Writeln;
  83. Writeln('MouseMoveCursor : ');
  84. Write('   Ready, Set, ');
  85. Ch := ReadKey;
  86. MouseMoveCursor(256,0);
  87. Writeln('Gone!');
  88. End; {Move_The_Mouse}
  89.  
  90. Procedure Box_Him_Up;
  91. Begin
  92. Writeln;
  93. Writeln('Restricting the mouse to a box.');
  94. MouseBox(80,400,24,96);
  95. Ch := ReadKey;
  96. MouseBox(0,632,0,192);
  97. Writeln('  Let him out again.');
  98. Ch := ReadKey;
  99. End; {Box_Him_Up}
  100.  
  101. Procedure Wait_Press;
  102. Var
  103.   WaitFor,ExitOn : Byte;
  104. Begin
  105. Writeln;
  106. Writeln('Wait for ''?'' to be PRESSED :');
  107. Writeln('  1) Left button');
  108. Writeln('  2) Right button');
  109. Writeln('  3) Middle button');
  110. Write  ('==> ');
  111. Repeat
  112.   Choice := ReadKey;
  113. Until (Choice in ['1','2','3']);
  114. Write(Choice);
  115. Case Choice of
  116.   '1' : WaitFor := Left;
  117.   '2' : WaitFor := Right;
  118.   '3' : WaitFor := Middle;
  119.   End;
  120. Writeln;
  121. Writeln('Exit routine on :');
  122. Writeln('  1) Left button');
  123. Writeln('  2) Right button');
  124. Writeln('  3) Middle button');
  125. Write  ('==> ');
  126. Repeat
  127.   Ch := ReadKey;
  128. Until (Ch in ['1','2','3']) and
  129.       (Ch <> Choice);
  130. Write(Ch);
  131. Case Ch of
  132.   '1' : ExitOn := Left;
  133.   '2' : ExitOn := Right;
  134.   '3' : ExitOn := Middle;
  135.   End;
  136. Writeln;
  137. Writeln('  Waiting...');
  138. MouseWaitPressed(WaitFor,ExitOn);
  139. If LeftButtonPressed then
  140.   Writeln('Left button pressed');
  141. If RightButtonPressed then
  142.   Writeln('Right button pressed');
  143. If MiddleButtonPressed then
  144.   Writeln('Middle button pressed');
  145. Ch := ReadKey;
  146. End; {Wait_Press}
  147.  
  148. Procedure Wait_Release;
  149. Var
  150.   WaitFor,ExitOn : Byte;
  151. Begin
  152. Writeln;
  153. Writeln('Wait for ''?'' to be RELEASED :');
  154. Writeln('  1) Left button');
  155. Writeln('  2) Right button');
  156. Writeln('  3) Middle button');
  157. Write  ('==> ');
  158. Repeat
  159.   Choice := ReadKey;
  160. Until (Choice in ['1','2','3']);
  161. Writeln(Choice);
  162. Case Choice of
  163.   '1' : WaitFor := Left;
  164.   '2' : WaitFor := Right;
  165.   '3' : WaitFor := Middle;
  166.   End;
  167. Writeln('Exit routine on :');
  168. Writeln('  1) Left button');
  169. Writeln('  2) Right button');
  170. Writeln('  3) Middle button');
  171. Write  ('==> ');
  172. Repeat
  173.   Ch := ReadKey;
  174. Until (Ch in ['1','2','3']) and
  175.       (Ch <> Choice);
  176. Writeln(Ch);
  177. Case Ch of
  178.   '1' : ExitOn := Left;
  179.   '2' : ExitOn := Right;
  180.   '3' : ExitOn := Middle;
  181.   End;
  182. Case WaitFor of
  183.   Left  : Writeln('Press the Left button');
  184.   Right : Writeln('Press the Right button');
  185.  Middle : Writeln('Press the Middle button');
  186.   end;
  187. MouseWaitPressed(WaitFor,ExitOn);
  188. Writeln('  Waiting...');
  189. MouseWaitReleased(WaitFor,ExitOn);
  190. If LeftButtonReleased then
  191.   Writeln('Left button released')
  192. Else
  193.   Writeln('Left button pressed');
  194.  
  195. If RightButtonReleased then
  196.   Writeln('Right button released')
  197. Else
  198.   Writeln('Right button pressed');
  199.  
  200. If MiddleButtonReleased then
  201.   Writeln('Middle button released')
  202. Else
  203.   Writeln('Middle button pressed');
  204. Writeln('  Done...');
  205. Ch := ReadKey;
  206. End; {Wait_Release}
  207.  
  208. Procedure DefaultGraphicsCursor;
  209. Var
  210.   GrDriver,GrMode : Integer;
  211. Begin
  212. Case ChooseDefaultCursor of
  213.   True : Begin
  214.          ChooseDefaultCursor := False;
  215.          MouseCursorOff;
  216.          ClrScr;
  217.          GrDriver := 0;
  218.          GrMode   := 0;
  219.          InitGraph(GrDriver,GrMode,'');
  220.          If (GraphResult <> 0) then
  221.            Begin
  222.            Writeln('GraphResult = ',GraphResult);
  223.            Ch := ReadKey;
  224.              MouseCursorOn;
  225.            Exit;
  226.            End;
  227.          MouseCursorOn;
  228.          While not KeyPressed do;
  229.          While KeyPressed do
  230.            Ch := ReadKey;
  231.          MouseCursorOff;
  232.          RestoreCrtMode;
  233.          MouseCursorOn;
  234.          End;
  235.  False : Begin
  236.          MouseCursorOff;
  237.          ClrScr;
  238.          GrDriver := 0;
  239.          GrMode   := 0;
  240.          InitGraph(GrDriver,GrMode,'');
  241.          If (GraphResult <> 0) then
  242.            Begin
  243.            Writeln('GraphResult = ',GraphResult);
  244.            Ch := ReadKey;
  245.            MouseCursorOn;
  246.            Exit;
  247.            End;
  248.          MouseSetGraphicsCursor('D',0,0);
  249.          MouseCursorOn;
  250.          While not KeyPressed do;
  251.          While KeyPressed do
  252.            Ch := ReadKey;
  253.          MouseCursorOff;
  254.          RestoreCrtMode;
  255.          MouseSetTextCursor(0,0,$0F18);
  256.          MouseCursorOn;
  257.          End;
  258.        End;
  259. End; {DefaultGraphicsCursor}
  260.  
  261. Procedure SetUpGraphicsCursor;
  262. Var
  263.   GrDriver,GrMode : Integer;
  264. Begin
  265. MouseCursorOff;
  266. ClrScr;
  267. GrDriver := 0;
  268. GrMode   := 0;
  269. InitGraph(GrDriver,GrMode,'');
  270. If (GraphResult <> 0) then
  271.   Begin
  272.   Writeln('GraphResult = ',GraphResult);
  273.   Ch := ReadKey;
  274.   MouseCursorOn;
  275.   Exit;
  276.   End;
  277. MouseSetGraphicsCursor('U',8,8);
  278. MouseCursorOn;
  279. While not KeyPressed do;
  280. While KeyPressed do
  281.   Ch := ReadKey;
  282. MouseCursorOff;
  283. RestoreCrtMode;
  284. MouseSetTextCursor(0,0,$0F18);
  285. MouseCursorOn;
  286. End; {SetUpGraphicsCursor}
  287.  
  288. Begin
  289. ChooseDefaultCursor := True;
  290. UserGraphCursor := NewCursor;
  291. TextMode(BW80);
  292. If MouseReset then                    {** Initialize the mouse **}
  293.   Writeln('MouseReset : ',M1,' ',M2,' ',M3,' ',M4)
  294. Else
  295.   Begin
  296.   Writeln('Mouse driver cannot be detected.');
  297.   Halt;
  298.   End;
  299. MouseCursorOn;                         {** Show the mouse cursor **}
  300. Writeln('MouseCursorOn : ',M1,' ',M2,' ',M3,' ',M4);
  301. Writeln;
  302. Repeat
  303.   Writeln('Mouse Demo Menu :            ');
  304.   Writeln('  A) Poll the Mouse.         F) Restrict mouse to a Box   ');
  305.   Writeln('  B) Left Button Pressed     G) Wait for a button PRESS   ');
  306.   Writeln('  C) Right Button Pressed    H) Wait for a button RELEASE ');
  307.   Writeln('  D) Middle Button Pressed.  I) Show default graphics cursor');
  308.   Writeln('  E) Move the Mouse          J) Show user graphics cursor');
  309.   Writeln(' (Q)uit                      ');
  310.   Choice := Upcase(ReadKey);
  311.   Case Choice of
  312.     'A' : PollTheMouse;
  313.     'B' : ReadLeftButton;
  314.     'C' : ReadRightButton;
  315.     'D' : ReadMiddleButton;
  316.     'E' : Move_The_Mouse;
  317.     'F' : Box_Him_Up;
  318.     'G' : Wait_Press;
  319.     'H' : Wait_Release;
  320.     'I' : DefaultGraphicsCursor;
  321.     'J' : SetUpGraphicsCursor;
  322.     End;
  323. MouseCursorOff;
  324. ClrScr;
  325. MouseCursorOn;
  326. Until (Choice = 'Q');
  327. MouseCursorOff;                        {** Turn of the mouse cursor **}
  328. Writeln('MousCursorOff');
  329. Writeln;
  330. Writeln('End of Mouse demo. Any key to exit. ');
  331. Writeln;
  332. Ch := ReadKey;
  333. ClrScr;
  334. End.